Celestin Apprentice 2/Apprentice-Release2.iso/Source Code/Peter Lewis/PNL Libraries/MyOOMainLoop.p

Text File | 1994-10-25 | 30.5 KB | 1,257 lines | [TEXT/PJMM]

unit MyOOMainLoop;

interface

    uses
        AppleEvents, Drag;

    const
        WT_NotMine = 'NtMe';
        WT_Generic = 'Genr';
        bad_window_id = -1;
        kAECloseAll = 'Clos';

    type
        SCType = (SCSave, SCCancel, SCDiscard);
        WObject = object
                window: dialogPtr;
                resid: integer;
                window_type: OSType;
                window_id: longInt;
                growRect: rect; { minimum/maximum rect size (for use with grow window) }
                zoomSize: point; { Optimum zoom size }
                zoomed: boolean;
                unzoomed: rect;
                draw_grow_icon: boolean;
                is_active: boolean;
                is_default_object: boolean;
                close_hides_window: boolean;
                last_event_time: longInt;
                last_event_modifers: integer;
                last_event_had_option: boolean;
                last_event_had_command: boolean;
                last_event_had_shift: boolean;
                last_event_had_control: boolean;
                AppleGuideWindowType: str31;
                procedure JointCreate (id: integer);
                procedure Create (id: integer);
                procedure CreateBehind (id: integer; behind: WindowPtr);
                procedure Destroy;
                procedure GetWindowPos (h: handle);
                procedure SetWindowPos (h: handle; var wasvisible: boolean);
                function SaveChanges: SCType;
                procedure DoClose;
{ DoClose checks modified things etc, then calls Destroy }
                function SetMenuBar: boolean;
                procedure SetMenus;
                function EditMenuEnabled: boolean;
                procedure SetEditMenuItem (item: integer);
                procedure DoEditMenu (item: integer);
                function GetAESelection (var reply: AppleEvent): OSErr;
                function GetAEWindow (var windowrec: AERecord): OSErr;
                function DoMenuKey (er: eventRecord; ch: char): longInt;
                procedure CalculateRegion (var rgn: rgnHandle);
                function WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
                procedure DoIdle;
                procedure DoDiskEvent (message: longInt);
                procedure DoSuspendResume (resume: boolean);
                procedure DoHighLevel (er: eventRecord);
                procedure DoContent (er: eventRecord);
                procedure DoKey (modifiers: integer; ch: char; code: integer);
                procedure DoSpecialKey (modifiers: integer; ch: char; code: integer);
                procedure DoAutoKey (modifiers: integer; ch: char; code: integer);
                procedure DoDrag (where: point);
                procedure DoGrow (where: point);
                procedure Zoom (zoomout: boolean; fullscreen: boolean);
                procedure DoZoom (where: point; code: integer);
                procedure DoGoAway (where: point);
                procedure DoUpdate;
                procedure DoMouseMoved (where: point);
                procedure DrawGrow;
                procedure DoActivateDeactivate (activate: boolean);
                procedure TextChanged; { called for paste/clear/cut/key down etc }
                procedure Resize;
                procedure InitialZoom (h, v: integer);
                procedure Draw;
                function TrackingHandler (message: DragTrackingMessage; dragref: DragReference): OSErr;
                function ReceiveHandler (dragref: DragReference): OSErr;
                function DragSend (flavor: FlavorType; item: ItemReference; dragref: DragReference): OSErr;
                function DoSetupDrag (dragref: DragReference; dragrgn: RgnHandle): OSErr;
                procedure DoTrackDrag (var er: EventRecord);
                function DoMainClick (er: eventRecord; wp: windowPtr; code: integer): boolean;
                function DoIsDialogEvent (er: eventRecord): boolean;
                function DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
                function HandleSimpleEvents (er: eventRecord): boolean;
                function HandleEvents (er: eventRecord): boolean;
            end;
        DObject = object(WObject)
                ok_item, cancel_item: integer;
                handle_activate_outline: boolean;
                handle_shift_tab: boolean;
                disable_edit_menu: boolean;
                procedure Create (id: integer);
                override;
                procedure CreateBehind (id: integer; behind: WindowPtr);
                override;
                procedure Destroy;
                override;
                procedure SetOOOutline (def_item, user_item: integer);
                procedure DrawOutline;
                procedure DoActivateDeactivate (activate: boolean);
                override;
                function HandleEvents (er: eventRecord): boolean;
                override;
                procedure DoItem (item: integer);
                procedure DoItemWhere (er: eventRecord; item: integer);
                procedure DoCancel (modifiers: integer; ch: char; code: integer);
                procedure DoOK (modifiers: integer; ch: char; code: integer);
                procedure SetEditMenuItem (item: integer);
                override;
                function EditMenuEnabled: boolean;
                override;
                procedure DoEditMenu (item: integer);
                override;
                function DoIsDialogEvent (er: eventRecord): boolean;
                override;
                function GetAESelection (var reply: AppleEvent): OSErr;
                override;
            end;

    var
        default_object: WObject;
        edit_menu_always_enabled: boolean;
        has_DragManager: boolean;

    function GetWType (wp: windowPtr): OSType;
    function GetWObject (wp: windowPtr): WObject;
    function GetDObject (dlg: dialogPtr): DObject;
    function FrontObject: WObject;
    function IsWObjectFront (o: WObject): boolean;
    function FindWindowID (id: longInt): WObject;
    procedure InitMainLoop (dobj: DObject; domenu: procptr);
{ dobj will be used returned with window set to wp whenever GetWObject/GetDObject is called with a DA or nil window }
    procedure FinishMainLoop;
{    procedure DoMenu (themenu, theitem: integer);}
    function InForeground: boolean;
    procedure DoCloseAll (all: boolean);

implementation

    uses
        AEObjects, AERegistry, Script, Processes, MyMenus, MyTypes, MyFMenus, BaseGlobals, MySystemGlobals, {}
        MyTEUtils, MyAssertions, MyDialogs, MyAEUtils, MyWindows, MyMathUtils, QLowLevel;

    const
        titlebar_hight = 18;

    const
{ from EPPC }
        OOMagic = 'MyOO';
        BadOOMagic = 'bado';

    type
        myWindowRecord = record
                thewindow: windowRecord;
                magic: OSType;
            end;
        myWindowPtr = ^myWindowRecord;
        myDialogRecord = record
                thedialog: dialogRecord;
                magic: OSType;
            end;
        myDialogPtr = ^myDialogRecord;

    var
        domenup: procptr;
        last_window_id: longInt;
        in_foreground: boolean;

    procedure DoMenu (themenu, theitem: integer; domenu: procptr);
    inline
        $205F, $4E90;

    procedure DoCloses (all: boolean);
        var
            fw: WindowPtr;
    begin
        if all then begin
            fw := FrontWindow;
            while fw <> nil do begin
                FrontObject.DoClose;
                if fw = FrontWindow then
                    leave;
                fw := FrontWindow;
            end;
        end
        else begin
            FrontObject.DoClose;
        end;
    end;

    function HandleClose (event, reply: AppleEvent; refcon: longInt): OSErr;
        var
            err: OSErr;
    begin
        if FrontWindow <> nil then begin
            DoCloses(refcon <> 0);
            err := noErr;
        end
        else begin
            err := errAENoSuchObject;
        end;
        HandleClose := err;
    end;

    procedure DoCloseAll (all: boolean);
    begin
        if has_AppleEvents then begin
            if all then begin
                SendSelfSimpleEvent(kAECoreSuite, kAECloseAll);
            end
            else begin
                SendSelfSimpleEvent(kAECoreSuite, kAEClose);
            end;
        end
        else begin
            DoCloses(all);
        end;
    end;

    function WObject.TrackingHandler (message: DragTrackingMessage; dragref: DragReference): OSErr;
    begin
        TrackingHandler := -1;
    end;

    function MyTrackingHandler (message: DragTrackingMessage; window: WindowPtr; refcon: Ptr; dragref: DragReference): OSErr;
    begin
        MyTrackingHandler := GetWObject(window).TrackingHandler(message, dragref);
    end;

    function WObject.ReceiveHandler (dragref: DragReference): OSErr;
    begin
        ReceiveHandler := -1;
    end;

    function MyReceiveHandler (window: WindowPtr; refcon: Ptr; dragref: DragReference): OSErr;
    begin
        MyReceiveHandler := GetWObject(window).ReceiveHandler(dragref);
    end;

    function WObject.DragSend (flavor: FlavorType; item: ItemReference; dragref: DragReference): OSErr;
    begin
        DragSend := -1;
    end;

    var
        drag_obj: WObject;

    function MyDragSendProc (flavor: FlavorType; refcon: Ptr; item: ItemReference; dragref: DragReference): OSErr;
    begin
        MyDragSendProc := drag_obj.DragSend(flavor, item, dragref);
    end;

{$S Init}
    procedure InitMainLoop (dobj: DObject; domenu: procptr);
        var
            i: integer;
            dummy: boolean;
            dummy_er: eventRecord;
            junk: OSErr;
            gv: longInt;
            err: OSErr;
    begin
        for i := 1 to 5 do
            dummy := EventAvail(everyEvent, dummy_er);
        has_DragManager := (Gestalt(gestaltDragMgrAttr, gv) = noErr) & (BTST(gv, gestaltDragMgrPresent));
        if has_DragManager then begin
            err := InstallTrackingHandler(@MyTrackingHandler, nil, nil);
            err := InstallReceiveHandler(@MyReceiveHandler, nil, nil);
        end;
        domenup := domenu;
        default_object := dobj;
        dobj.window := nil;
        dobj.window_id := bad_window_id;
        dobj.JointCreate(0);
        dobj.is_default_object := true;
        dobj.window_type := WT_NotMine;
        last_window_id := 1;
        edit_menu_always_enabled := false;
        if has_AppleEvents then begin
            junk := AEInstallEventHandler(kAECoreSuite, kAEClose, @HandleClose, 0, false);
            junk := AEInstallEventHandler(kAECoreSuite, kAECloseAll, @HandleClose, 1, false);
        end;
    end;

{$S Term}
    procedure FinishMainLoop;
    begin
        dispose(default_object);
    end;

{$S}
    function InForeground: boolean;
        var
            gv: longInt;
            ourpsn, frontpsn: ProcessSerialNumber;
            front: boolean;
    begin
        if (Gestalt(gestaltOSAttr, gv) = noErr) & (BTST(gv, gestaltLaunchControl)) then begin
            if (GetCurrentProcess(ourpsn) = noErr) & (GetFrontProcess(frontpsn) = noErr) then begin
                if SameProcess(ourpsn, frontpsn, front) = noErr then
                    in_foreground := front;
            end;
        end;
        InForeground := in_foreground;
    end;

    function GetWRC (wp: windowPtr): WObject;
        var
            rc: longInt;
    begin
        rc := 0;
        if (wp <> nil) & (windowPeek(wp)^.windowKind >= 0) then begin
            if ((windowPeek(wp)^.windowKind = dialogKind) & (myDialogPtr(wp)^.magic = OOMagic)) | (myWindowPtr(wp)^.magic = OOMagic) then
                rc := GetWRefCon(wp);
        end;
        if rc = 0 then begin
            default_object.window := wp;
            rc := longInt(default_object);
        end;
        GetWRC := WObject(rc);
    end;

    function GetWType (wp: windowPtr): OSType;
        var
            wo: WObject;
    begin
        wo := GetWRC(wp);
        if wo.is_default_object then
            GetWType := WT_NotMine
        else
            GetWType := wo.window_type;
    end;

    function GetWObject (wp: windowPtr): WObject;
    begin
        GetWObject := GetWRC(wp);
    end;

    function FindWindowID (id: longInt): WObject;
        const
            WindowList = $9D6;
        type
            WindowPtrPtr = ^WindowPtr;
        var
            w: windowPtr;
            wo: WObject;
    begin
        FindWindowID := nil;
        if id <> bad_window_id then begin
            w := WindowPtrPtr(WindowList)^;
            while w <> nil do begin
                wo := GetWObject(w);
                if (not wo.is_default_object) & (wo.window_id = id) then begin
                    FindWindowID := wo;
                    leave;
                end;
                w := windowPtr(windowPeek(w)^.nextWindow);
            end;
        end;
    end;

    function GetDObject (dlg: dialogPtr): DObject;
    begin
        GetDObject := DObject(GetWRC(dlg));
    end;

    function FrontObject: WObject;
    begin
        FrontObject := GetWRC(FrontWindow);
    end;

    function IsWObjectFront (o: WObject): boolean;
    begin
        if o = nil then
            IsWObjectFront := false
        else if o.window = nil then
            IsWObjectFront := false
        else
            IsWObjectFront := o.window = FrontWindow;
    end;

    function WObject.DoSetupDrag (dragref: DragReference; dragrgn: RgnHandle): OSErr;
    begin
        DoSetupDrag := -1;
    end;

    procedure WObject.DoTrackDrag (var er: EventRecord);
        var
            err: OSErr;
            dragref: DragReference;
            dragrgn: RgnHandle;
    begin
        drag_obj := self;
        err := NewDrag(dragref);
        if err = noErr then begin
            dragrgn := NewRgn;
            err := MemError;
            if err = noErr then begin
                err := DoSetupDrag(dragref, dragrgn);
                if err = noErr then begin
                    err := SetDragSendProc(dragref, @MyDragSendProc, nil);
                end;
                if err = noErr then begin
                    err := TrackDrag(dragref, er, dragrgn);
                end;
                DisposeRgn(dragrgn);
            end;
            err := DisposeDrag(dragref);
        end;
    end;

    function WObject.SaveChanges: SCType;
        var
            a: integer;
            title: str255;
    begin
        SelectWindow(window);
        GetWTitle(window, title);
        if quitNow then begin
            ParamText(title, GetGlobalString(quiting_str), '', '');
        end
        else begin
            ParamText(title, GetGlobalString(closing_str), '', '');
        end;
        SetCursor(arrow);
        a := CautionAlert(save_changes_alert_id, @CancelDiscardModalFilter);
        SaveChanges := SCType(a - 1);
    end;

    function WObject.EditMenuEnabled: boolean;
    begin
        if window = nil then
            EditMenuEnabled := false
        else
            EditMenuEnabled := windowPeek(window)^.windowKind < 0
    end;

    function WObject.SetMenuBar: boolean;
        var
            oldEditEnabled, editEnabled: boolean;
    begin
        oldEditEnabled := GetIDItemEnable(M_Edit, 0);
        editEnabled := FrontObject.EditMenuEnabled or edit_menu_always_enabled;
        if editEnabled <> oldEditEnabled then
            SetIDItemEnable(M_Edit, 0, editEnabled);
        SetMenuBar := editEnabled <> oldEditEnabled;
    end;

    procedure WObject.SetMenus;
    begin
        SetFMenus;
    end;

    procedure WObject.SetEditMenuItem (item: integer);
    begin
        if not EditMenuEnabled then
            SetIDItemEnable(M_Edit, item, false);
    end;

    procedure WObject.DoEditMenu (item: integer);
        var
            dummyb: boolean;
    begin
        if item <= 6 then
            dummyb := SystemEdit(item - 1);
    end;

    function WObject.GetAESelection (var reply: AppleEvent): OSErr;
    begin
        GetAESelection := errAENoUserSelection;
    end;

    function WObject.GetAEWindow (var windowrec: AERecord): OSErr;
        var
            err, junk: OSErr;
            s: str255;
            r: rect;
    begin
        AECreate(windowrec);
        if is_default_object then begin
            err := errAEDescNotFound;
        end
        else begin
            err := AECreateList(nil, 0, true, windowrec);
            GetWTitle(window, s);
            if err = noErr then begin
                junk := PutStringToAERecord(windowrec, pName, s);
                r := window^.portRect;
                SetPort(window);
                LocalToGlobal(r.topleft);
                LocalToGlobal(r.botright);
                junk := AEPutKeyPtr(windowrec, pBounds, typeQDRectangle, @r, SizeOf(r));
                junk := AEPutKeyPtr(windowrec, pPosition, typeQDPoint, @r.topleft, SizeOf(r.topleft));
            end;
        end;
        GetAEWindow := err;
    end;

    function WObject.DoMenuKey (er: eventRecord; ch: char): longInt;
        const
            kMaskVirtualKey = $0000FF00; {get virtual key from event message}
            kMaskASCII1 = $00FF0000;
            kMaskASCII2 = $000000FF; {get key from KeyTrans return}
            kKeyUpMask = $0080;
        var
            h: handle;
            virtualKey, keyCId, state, keyInfo: longInt;
            keycode: integer;
            lowchar, highchar: integer;
    begin
        if BAND(er.modifiers, optionKey) <> 0 then begin
            virtualKey := BSR(BAND(er.message, kMaskVirtualKey), 8);
            keyCode := BOR(BOR(BXOR(er.modifiers, optionKey), kKeyUpMask), virtualKey);
            state := 0;

            keyCId := GetScript(GetEnvirons(smKeyScript), smScriptKeys);
            h := GetResource('KCHR', keyCId);

            if h <> nil then begin
                HLock(h); { KeyTrans won't move memory, but lock it anyway to avoid any purgine or foolishness }
                keyInfo := KeyTrans(h^, keyCode, state);
                ReleaseResource(h);
                LowChar := BAND(keyInfo, $FF);
                HighChar := BAND(BSR(keyInfo, 16), $FF);
                if lowChar <> 0 then
                    ch := chr(lowChar);
                if highChar <> 0 then
                    ch := chr(highChar);
            end;
        end;
        DoMenuKey := MenuKey(ch);
    end;

    procedure WObject.CalculateRegion (var rgn: rgnHandle);
    begin
        SetCursor(arrow);
        rgn := nil;
    end;

    function WObject.WaitForEvent (var er: eventRecord; sleep: longInt): boolean;
        var
            rgn: rgnHandle;
            b: boolean;
    begin
        CalculateRegion(rgn);
        WaitForEvent := WaitNextEvent(everyEvent, er, sleep, rgn);
        if rgn <> nil then
            DisposeRgn(rgn);
    end;

    procedure WObject.DoDiskEvent (message: longInt);
        var
            pt: point;
            oe: OSErr;
    begin
        if (HiWord(message) <> noErr) then begin
            pt.h := ((screenbits.bounds.Right - screenbits.bounds.Left - 304) div 2);
            pt.v := ((screenbits.bounds.Bottom - screenbits.bounds.Top - 156) div 3);
            InitCursor;
            oe := DIBadMount(pt, message);
        end;
    end;

    procedure WObject.DoSuspendResume (resume: boolean);
    begin
        in_foreground := resume;
        if FrontWindow <> nil then begin
            FrontObject.DoActivateDeactivate(resume);
        end;
        InitCursor;
    end;

    procedure WObject.DoHighLevel (er: eventRecord);
        var
            oe: OSErr;
    begin
        if has_AppleEvents then
            oe := AEProcessAppleEvent(er);
    end;

    procedure WObject.JointCreate (id: integer); { Called for DefaultObject too! }
    begin
        MoveHHi(handle(self));
        HLock(handle(self));
        AppleGuideWindowType := '';
        if window <> nil then begin
            SetWRefCon(window, ord(self));
            GetWindowRect(window, unzoomed);
        end;
        zoomed := false;
        close_hides_window := false;
        SetRect(growRect, 63, 61, 25000, 25000);
        zoomSize.h := 30000;
        zoomSize.v := 30000;
        window_type := WT_Generic;
        draw_grow_icon := false;
        window_id := last_window_id;
        last_window_id := last_window_id + 1;
        resid := id;
        is_default_object := false;
    end;

    procedure WObject.CreateBehind (id: integer; behind: WindowPtr);
        var
            wp: myWindowPtr;
    begin
        wp := myWindowPtr(NewPtr(SizeOf(myWindowRecord)));
        wp^.magic := OOMagic;
        window := GetNewWindow(id, ptr(wp), behind);
        JointCreate(id);
    end;

    procedure WObject.Create (id: integer);
    begin
        CreateBehind(id, POINTER(-1));
    end;

    procedure WObject.Destroy;
    begin
        if (window <> nil) & (GetWType(window) <> WT_NotMine) then begin
            myWindowPtr(window)^.magic := BadOOMagic;
            DisposeWindow(window);
            dispose(self);
        end;
    end;

    type
        savedWindowRecord = record
                windowpos: rect; { the window position }
                windowvis: rect; { the visible part of the title bar }
                zoomed: boolean;
                visible: boolean;
            end;
        savedWindowPtr = ^savedWindowRecord;
        savedWindowHandle = ^savedWindowPtr;

    procedure WObject.GetWindowPos (h: handle);
        var
            rgn: RgnHandle;
            r1, r2, global_portrect: rect;
    begin
        HUnlock(h);
        SetHandleSize(h, SizeOf(savedWindowRecord));
        HLock(h);
        with savedWindowHandle(h)^^ do begin
            SetPort(window);
            visible := windowPeek(window)^.visible;
            GetWindowPortRect(window, global_portrect);
            LocalToGlobal(global_portrect.topleft);
            LocalToGlobal(global_portrect.botright);
            windowpos := global_portrect;
            windowpos.top := windowpos.top - titlebar_hight; { title bar }
            rgn := NewRgn;
            RectRgn(rgn, windowpos);
            SectRgn(GetGrayRgn, rgn, rgn);
            windowvis := rgn^^.rgnBBox;
            DisposeRgn(rgn);
            r1 := global_portrect;
            GetWindowStandardState(window, r2);
            InsetRect(r1, -7, -7);
            zoomed := PtInRect(r2.topLeft, r1) and PtInRect(r2.botRight, r1);
        end;
        HUnlock(h);
    end;

    procedure WObject.SetWindowPos (h: handle; var wasvisible: boolean);
        var
            rgn: RgnHandle;
            r: rect;
            dummy: boolean;
    begin
        if (h <> nil) & (GetHandleSize(h) = SizeOf(savedWindowRecord)) then begin
            HLock(h);
            with savedWindowHandle(h)^^ do begin
                wasvisible := visible;
                rgn := NewRgn;
                RectRgn(rgn, windowvis);
                SectRgn(GetGrayRgn, rgn, rgn);
                r := rgn^^.rgnBBox;
                DisposeRgn(rgn);
                dummy := SectRect(r, windowvis, r);
                if (longInt(r.topleft) = longInt(windowvis.topleft)) & (longInt(r.botright) = longInt(windowvis.botright)) then begin
                    with windowpos do begin
                        MoveWindow(window, left, top + titlebar_hight, true);
                        SizeWindow(window, right - left, bottom - top - titlebar_hight, true);
                    end;
                end;
                if zoomed then begin
                    Zoom(true, false);
                end
                else begin
                    Resize;
                end;
            end;
            HUnlock(h);
        end
        else
            wasvisible := true;
    end;

    procedure WObject.DoClose;
    begin
        if close_hides_window then begin
            HideWindow(window);
        end
        else begin
            Destroy;
        end;
    end;

    procedure WObject.DoContent (er: eventRecord);
    begin
    end;

    procedure WObject.DoKey (modifiers: integer; ch: char; code: integer);
    begin
        SysBeep(1);
    end;

    procedure WObject.DoSpecialKey (modifiers: integer; ch: char; code: integer);
        var
            item: integer;
    begin
        item := -1;
        if not system7 then begin
            case code of
                undoKey:
                    item := EMundo;
                cutKey:
                    item := EMcut;
                copyKey:
                    item := EMcopy;
                pasteKey:
                    item := EMpaste;
                clearKey:
                    item := EMclear;
                otherwise
                    ;
            end;
        end;
        if item <> -1 then begin
            SetMenus;
            if not GetIDItemEnable(M_Edit, 0) or not GetIDItemEnable(M_Edit, item) then
                item := -1;
        end;
        if item = -1 then
            DoKey(modifiers, ch, code)
        else
            DoMenu(M_Edit, item, domenup);
    end;

    procedure WObject.DoAutoKey (modifiers: integer; ch: char; code: integer);
    begin
        DoKey(modifiers, ch, code);
    end;

    procedure WObject.DoDrag (where: point);
        var
            temprect: rect;
    begin
        SetPort(window);
        tempRect := GetGrayRgn^^.rgnBBox;
        DragWindow(window, where, tempRect);
    end;

    procedure WObject.DoGrow (where: point);
        var
            mypt: point;
            oldrect: rect;
            mResult: longInt;
            tempRect: rect;
    begin
        SetPort(window);
        myPt := where;
        GlobalToLocal(myPt);
        GetWindowPortRect(window, oldrect);
        mResult := GrowWindow(window, where, growRect);
        SizeWindow(window, LoWord(mResult), HiWord(mResult), TRUE);
        SetRect(tempRect, 0, myPt.v - 15, myPt.h + 15, myPt.v + 15);
        EraseRect(tempRect);
        InvalRect(tempRect);
        SetRect(tempRect, myPt.h - 15, 0, myPt.h + 15, myPt.v + 15);
        EraseRect(tempRect);
        InvalRect(tempRect);
        zoomed := false;
        Resize;
    end;

    procedure WObject.Zoom (zoomout: boolean; fullscreen: boolean);
        var
            zoompt: Point;
    begin
        if fullscreen then begin
            SetPt(zoompt, 30000, 30000);
        end
        else begin
            zoompt := zoomSize;
        end;
        zoompt.h := Max(zoompt.h, growRect.left);
        zoompt.v := Max(zoompt.v, growRect.top);
        ZoomTheWindow(window, zoomout, zoompt, unzoomed);
        Resize;
        zoomed := zoomout;
    end;

    procedure WObject.DoZoom (where: point; code: integer);
    begin
        SetPort(window);
        if TrackBox(window, where, code) then begin
            Zoom(not zoomed, last_event_had_option);
        end;
    end;

    procedure WObject.InitialZoom (h, v: integer);
        var
            old: Point;
            r: rect;
    begin
        Resize;
        old := zoomSize;
        if h <> 0 then begin
            zoomSize.h := h;
        end;
        if v <> 0 then begin
            zoomSize.v := v;
        end;
        Zoom(true, false);
        zoomSize := old;
        zoomed := false;
        GetWindowRect(window, unzoomed);
    end;

    procedure WObject.DoGoAway (where: point);
    begin
        if TrackGoAway(window, where) then begin
            DoCloseAll(last_event_had_option);
        end;
    end;

    procedure WObject.DoUpdate;
        var
            r: rect;
    begin
        BeginUpdate(window);
        Draw;
        EndUpdate(window);
    end;

    procedure WObject.TextChanged;
    begin
    end;

    procedure WObject.DoMouseMoved (where: point);
    begin
    end;

    procedure WObject.DrawGrow;
    begin
        DrawGrowIcon(window);
    end;

    procedure WObject.DoActivateDeactivate (activate: boolean);
    begin
        Assert(window <> nil);
        is_active := activate and windowPeek(window)^.visible;
        if is_active then
            SelectWindow(window);
        if draw_grow_icon then
            DrawGrow;
    end;

    procedure WObject.Resize;
    begin
        if draw_grow_icon then
            DrawGrow;
    end;

    procedure WObject.Draw;
    begin
        if draw_grow_icon then
            DrawGrow;
    end;

    function WObject.DoIsDialogEvent (er: eventRecord): boolean;
    begin
        DoIsDialogEvent := IsDialogEvent(er);
    end;

    function WObject.DoDialogSelect (er: eventRecord; var dlg: dialogPtr; var item: integer): boolean;
    begin
        DoDialogSelect := DialogSelect(er, dlg, item);
    end;

    procedure WObject.DoIdle;
    begin
    end;

    function WObject.DoMainClick (er: eventRecord; wp: windowPtr; code: integer): boolean;
        var
            b: boolean;
            mResult: longInt;
            needsselect: boolean;
    begin
        b := false;
        needsselect := (wp <> nil) & (wp <> FrontWindow);
        if needsselect & not (code in [inDrag, inContent]) then begin
            SelectWindow(wp);
        end;
        case code of
            inMenuBar:  begin
                SetMenus;
                mResult := MenuSelect(er.where);
                if mResult <> 0 then
                    DoMenu(HiWord(mResult), LoWord(mResult), domenup);
                if not quitNow then begin
                    HiliteMenu(0);
                end;
            end;
            InDrag:  begin
                if needsselect and (BAND(er.modifiers, cmdKey) = 0) then begin
                    SelectWindow(wp);
                end;
                DoDrag(er.where);
            end;
            inGrow:
                DoGrow(er.where);
            inZoomIn, inZoomOut:
                DoZoom(er.where, code);
            inGoAway:
                DoGoAway(er.where);
            inContent:  begin
                if needsselect then begin
                    SelectWindow(wp);
                end;
                DoContent(er);
            end;
            inSysWindow:
                SystemClick(er, window);
            otherwise
                b := true;
        end;
        DoMainClick := b;
    end;

    function WObject.HandleSimpleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            ch: char;
            mResult: longInt;
            code: integer;
            wp: WindowPtr;
    begin
        b := false;
        case er.what of
            MouseDown:  begin
                code := FindWindow(er.where, wp);
                if wp = nil then begin
                    wp := FrontWindow;
                end;
                b := GetWObject(wp).DoMainClick(er, wp, code);
            end;

            KeyDown:  begin
                ch := chr(BAND(er.message, CharCodeMask));
                mResult := 0;
                if BAND(er.modifiers, CmdKey) <> 0 then begin
                    SetMenus;
                    mResult := DoMenuKey(er, ch);
                end;
                if mResult <> 0 then begin
                    DoMenu(HiWord(mResult), LoWord(mResult), domenup);
                end
                else begin
                    DoSpecialKey(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
                end;
            end;

            AutoKey:
                DoAutoKey(er.modifiers, chr(BAND(er.message, CharCodeMask)), BAND(er.message, keyCodeMask) div $100);

            UpdateEvt:
                GetWObject(windowPtr(er.message)).DoUpdate;

            ActivateEvt:
                GetWObject(windowPtr(er.message)).DoActivateDeactivate(odd(er.modifiers));

            kOSEvent:
                if BAND(BROTL(er.message, 8), $FF) = kSuspendResumeMessage then begin
                    DoSuspendResume(BAnd(er.message, kResumeMask) <> 0);
                end
                else if BAND(BROTL(er.message, 8), $FF) = kMouseMovedMessage then begin
                    DoMouseMoved(er.where);
                end
                else begin
                    b := true;
                end;

            kHighLevelEvent:
                DoHighLevel(er);

            DiskEvt:
                DoDiskEvent(er.message);

            otherwise
                b := true;
        end;
        HandleSimpleEvents := b;
    end;

    function WObject.HandleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            dlg: dialogPtr;
            item: integer;
    begin
        last_event_time := er.when;
        last_event_modifers := er.modifiers;
        last_event_had_option := BAND(er.modifiers, optionKey) <> 0;
        last_event_had_command := BAND(er.modifiers, cmdKey) <> 0;
        last_event_had_shift := BAND(er.modifiers, shiftKey) <> 0;
        last_event_had_control := BAND(er.modifiers, controlKey) <> 0;
        DoIdle;
        b := true;
        if DoIsDialogEvent(er) then begin
            if DoDialogSelect(er, dlg, item) then begin
                GetDObject(dlg).DoItemWhere(er, item);
                b := false;
            end;
        end;
        if b then begin
            b := HandleSimpleEvents(er);
        end;
        HandleEvents := b;
    end;

    procedure DObject.CreateBehind (id: integer; behind: WindowPtr);
        var
            wp: myDialogPtr;
    begin
        disable_edit_menu := false;
        wp := myDialogPtr(NewPtr(SizeOf(myDialogRecord)));
        wp^.magic := OOMagic;
        window := GetNewDialog(id, ptr(wp), behind);
        ok_item := 0;
        cancel_item := 0;
        handle_activate_outline := false;
        handle_shift_tab := true;
        JointCreate(id);
    end;

    procedure DObject.Create (id: integer);
    begin
        CreateBehind(id, POINTER(-1));
    end;

    procedure DObject.Destroy;
    begin
        if (window <> nil) & (GetWType(window) <> WT_NotMine) then begin
            myDialogPtr(window)^.magic := BadOOMagic;
            DisposDialog(window);
            dispose(self);
        end;
    end;

    procedure OODrawOutline (dp: dialogPtr; item: integer);
        var
            r: rect;
            fi: DObject;
            pstate: PenState;
    begin
        SetPort(dp);
        GetPenState(pstate);
        fi := DObject(GetWObject(dp));
        GetDItemRect(dp, fi.ok_item, r);
        InsetRect(r, -4, -4);
        PenSize(3, 3);
        if not GetDCtlEnable(dp, fi.ok_item) or not fi.is_active then begin
            PenPat(gray);
            FrameRoundRect(r, 16, 16);
            PenPat(black);
        end
        else
            FrameRoundRect(r, 16, 16);
        SetPenState(pstate);
    end;

    procedure DObject.DrawOutline;
    begin
        OODrawOutline(window, ok_item);
    end;

    procedure DObject.SetOOOutline (def_item, user_item: integer);
        var
            kind: integer;
            h: handle;
            r: rect;
    begin
        handle_activate_outline := true;
        ok_item := def_item;
        GetDItem(window, user_item, kind, h, r);
        InsetRect(r, -10, -10);
        SetDItem(window, user_item, userItem, handle(@OODrawOutline), r);
    end;

    procedure DObject.DoActivateDeactivate (activate: boolean);
    begin
        inherited DoActivateDeactivate(activate);
        if handle_activate_outline then
            OODrawOutline(window, 0);
    end;

    procedure DObject.DoOK (modifiers: integer; ch: char; code: integer);
    begin
        if ok_item = 0 then
            DoKey(modifiers, ch, code)
        else begin
            if GetDCtlEnable(window, ok_item) then begin
                FlashDItem(window, ok_Item);
                DoItem(ok_item);
            end;
        end;
    end;

    procedure DObject.DoCancel (modifiers: integer; ch: char; code: integer);
    begin
        if cancel_item = 0 then
            DoKey(modifiers, ch, code)
        else begin
            FlashDItem(window, cancel_Item);
            DoItem(cancel_item);
        end;
    end;

    procedure DObject.DoItem (item: integer);
    begin
    end;

    procedure DObject.DoItemWhere (er: eventRecord; item: integer);
    begin
        DoItem(item);
    end;

    function DObject.HandleEvents (er: eventRecord): boolean;
        var
            b: boolean;
            ch: char;
    begin
        b := true;
        if ((er.what = KeyDown) or (er.what = AutoKey)) then begin
            b := false;
            ch := chr(BAND(er.message, charCodeMask));
            if (ch = chr(13)) or (ch = chr(3)) then begin
                DoOK(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
            end
            else if (ch = chr(27)) or ((ch = '.') and (BAND(er.modifiers, cmdKey) <> 0)) then begin
                DoCancel(er.modifiers, ch, BAND(er.message, keyCodeMask) div $100);
            end
            else if (ch = tab) and (BAND(er.modifiers, shiftKey) <> 0) then begin
                if handle_shift_tab then begin
                    ShiftTab(window);
                end
                else begin
                    b := true;
                end;
            end
            else begin
                b := true;
            end;
        end;
        if b then begin
            b := inherited HandleEvents(er);
        end;
        HandleEvents := b;
    end;

    procedure DObject.SetEditMenuItem (item: integer);
    begin
        if is_default_object or disable_edit_menu or (SelectedTextItem(window) <= 0) then begin
            SetIDItemEnable(M_Edit, item, false);
        end
        else begin
            TESetEditMenuItem(dialogPeek(window)^.textH, false, 250, item);
        end;
    end;

    function DObject.EditMenuEnabled: boolean;
    begin
        if is_default_object or disable_edit_menu or (SelectedTextItem(window) <= 0) then begin
            EditMenuEnabled := false;
        end
        else begin
            EditMenuEnabled := TEEditMenuEnabled(dialogPeek(window)^.textH, false, 250);
        end;
    end;

    procedure DObject.DoEditMenu (item: integer);
        var
            loe: longInt;
            oe: OSErr;
    begin
        case item of
            EMUndo:
                ;
            EMCut:  begin
                DlgCut(window);
                loe := ZeroScrap;
                oe := TEToScrap;
                TextChanged;
            end;
            EMCopy:  begin
                DlgCopy(window);
                loe := ZeroScrap;
                oe := TEToScrap;
            end;
            EMPaste:  begin
                oe := TEFromScrap;
                DlgPaste(window);
                TextChanged;
            end;
            EMClear:  begin
                DlgDelete(window);
                TextChanged;
            end;
            EMSelectAll:  begin
                if (SelectedTextItem(window) > 0) then begin
                    SelIText(window, SelectedTextItem(window), 0, maxInt);
                end;
            end;
            otherwise
                ;
        end;
    end;

    function DObject.GetAESelection (var reply: AppleEvent): OSErr;
        var
            err: OSErr;
    begin
        if not is_default_object & (SelectedTextItem(window) > 0) then begin
            err := PutTESelectionToAERecord(reply, keyDirectObject, dialogPeek(window)^.textH);
        end
        else begin
            err := errAENoUserSelection;
        end;
        GetAESelection := err;
    end;

    function DObject.DoIsDialogEvent (er: eventRecord): boolean;
    begin
        if ((er.what = keyDown) or (er.what = autoKey)) and (BAND(er.modifiers, cmdKey) <> 0) then begin
            DoIsDialogEvent := false; { Stop system 7 from doing the edit menu as well }
        end
        else begin
            DoIsDialogEvent := inherited DoIsDialogEvent(er);
        end;
    end;

end.